 IOI. 16 (Autobuze). Un om soseste la statia de autobuz la ora 12.00 si
sta aici pna la 12.59. In statii sosesc autobuze de pe diverse trasee; omul
nostru noteaza fiecare timp de sosire. Se stie ca:
- autobuzele de pe fiecare traseu sosesc la intervale regulate de timp; sunt
cel mult 17 trasee;
- n intervalul 12.00-12.59 fiecare traseu are cel putin doua opriri n
statie;
- n acelasi moment pot opri autobuze de pe mai multe trasee;
- pot fi trasee care au acelasi timp de sosire si/sau aceeasi perioada ntre
doua opriri succesive. Daca exista doua rute cu acelasi timp de plecare si
aceeasi perioada, ele sunt distincte.
  Se cere sa se determine cel mai mic numar de trasee de autobuz care au
oprire n statie. Pentru fiecare astfel de traseu sa se precizeze prima
oprire din intervalul 12.00-12.59 precum si intervalul dintre doua opriri.
Intrare: Fisierul de intrare contine numarul n (2n300) care arata cte
autobuze au oprit n statie; el este urmat de toti timpii de sosire, scrisi
n ordine crescatoare.
Iesire: Fisierul de iesire va avea cte o linie pentru fiecare traseu. Pe ea
se afla momentul sosirii primului autobuz si intervalul de timp (n minute).
Ordinea de scriere a traseelor este arbitrara. Daca sunt mai multe solutii,
se cere numai una.
Exemplu: La intrarea
17
0 3 5 13 13 15 21 26 27 29 37 39 39 45 51 52 53
iesirea este:
0 13
3 12
5 8
======================================
Solutia 1 (Mihai Stroe)

    Problema cere determinarea unui numar minim de progresii aritmetice care
  sa acopere datele de intrare. Metoda de rezolvare este backtracking.
    La fiecare moment k se gasesc pentru primul element progresiile in care
  el poate intra; pentru fiecare varianta, progresia gasita se elimina si se
  continua procesul pentru progresia nr. k+1 (cu noile date de intrare pentru
  backtracking). In final se prezinta solutia.

var a:array[0..17,0..60]of byte;
    stopt,ropt,st,ratie:array[1..17]of byte;
    i,j,k,l,m,n,kopt:longint;
    fi,fo:text;
    s:string;
    gasit:boolean;

procedure readdata;
begin
  write('Type input file name ');
  readln(s);
  assign(fi,s);
  reset(fi);
  readln(fi,n);
  for i:=1 to n do
      begin
        read(fi,j);
        inc(a[0,j]);
      end;
  close(fi);
end;

procedure react;
begin
  stopt:=st;
  ropt:=ratie;
  kopt:=k;
end;

function solutie:boolean;
begin
  solutie:=true;
  for i:=1 to 60 do
      if a[k,i]<>0 then solutie:=false;
end;

function progresie:boolean;
var ii,jj:byte;
begin
  progresie:=true;
  jj:=st[k]-m;
  for i:=0 to 59 do if((m-i)mod jj=0)and(a[k,i]=0)then progresie:=false;
end;

procedure find;
begin
  gasit:=true;
  a[k]:=a[k-1];
  m:=st[k]+1;while (a[k,m]=0)and(m<60) do inc(m);
  if st[k]<=m then st[k]:=m+1;if m=60 then begin gasit:=false;exit;end;
  while (not progresie)and (st[k]<60) do
    begin
      while(a[k,st[k]]=0)and(st[k]<60)do inc(st[k]);
      if st[k]=60 then gasit:=false;
      if not progresie then inc(st[k]);
    end;
  if gasit then
     begin
       ratie[k]:=st[k]-m;
       for i:=0 to 59 do if((m-i)mod ratie[k]=0)then dec(a[k,i]);
     end;
end;

procedure solve;
begin
  k:=1;
  while k>0 do
    begin
      find;
      if gasit=false then
         begin
           st[k]:=0;
           ratie[k]:=0;
           dec(k)
         end
         else
         begin
           if solutie then begin react;end;
           if k<kopt then
              inc(k);
         end;
    end;
end;

begin
  kopt:=18;
  readdata;
  solve;
  write('Type output file name ');
  readln(s);
  assign(fo,s);
  rewrite(fo);
  if kopt=18 then begin writeln(fo,'No solution');close(fo);halt;end;
  for i:=1 to kopt do
      writeln(fo,stopt[i] mod ropt[i],' ',ropt[i]);
  close(fo);
end.
---------------------------------------
Solutia 2  (Catalin Francu)
program Autobuze;
type TimeVector=array[0..118] of Integer; {Pentru a evita range check error}
     RouteType=record
                 T0,DeltaT:Integer;
               end;
     RouteVector=array[1..300] of RouteType;
var Bus:TimeVector;
    Route,BestRoute:RouteVector;
    N,BestN:Integer;
    InName,OutName:String;

procedure ReadData;
var i,T:Integer;
begin
  for i:=0 to 59 do Bus[i]:=0;
  Read(N);
  for i:=1 to N do
    begin
      Read(T);
      Inc(Bus[T]);
    end;
  BestN:=MaxInt;
end;

procedure IGotOne(NRoutes:Integer);
begin
  if NRoutes<BestN then begin
                          BestN:=NRoutes;
                          BestRoute:=Route;
                        end;
end;

function LineOk(First,Period:Integer):Boolean;
begin
  while (Bus[First]>0) and (First<=59) do Inc(First,Period);
  LineOk:=(First>59);
end;

procedure AddBuses(First,Period,Count:Integer);
begin
  while (First<=59) do
    begin
      Inc(Bus[First],Count);
      Inc(N,Count);
      Inc(First,Period);
    end;
end;

procedure Place(First,Level:Integer);
var Period:Integer;
begin
  if N=0
    then IGotOne(Level-1)
    else if Level<BestN
           then begin
                  while Bus[First]=0 do Inc(First);
                  for Period:=First+1 to 50-First+1 do
                    if LineOk(First,Period)
                      then begin
                             AddBuses(First,Period,-1);
                             with Route[Level] do
                               begin
                                 T0:=First;
                                 DeltaT:=Period;
                               end;
                             Place(First,Level+1);
                             AddBuses(First,Period,1);
                           end;
                end;
end;

procedure WriteSolution;
var i:Integer;
begin
  for i:=1 to BestN do
    with BestRoute[i] do
      WriteLn(T0,' ',DeltaT);
end;

begin
  Write('Numele fisierului de intrare: ');ReadLn(InName);
  Write('Numele fisierului de iesire: ');ReadLn(OutName);
  Assign(Input,InName);Reset(Input);
  Assign(Output,OutName);Rewrite(Output);
  ReadData;
  Place(0,1);
  WriteSolution;
  Close(Input);Close(Output);
end.
---------------------------------------------
Solutie Vlad Atanasiu:
Program:
uses crt;
var a:array[1..300] of byte;
    folosit:array[1..300] of boolean;
    solutie,vector:array[1..100] of integer;
    i,tminim,nr_autobuze:integer;

function verifica(t,n:integer):boolean;
var i,j:integer;
    gasit:boolean;
begin
gasit:=true;
i:=a[t]; { i este timpul opririi t }
j:=1;
while (i<=59) and gasit do
      begin
      { daca nu exista oprirea cu timpul i }
      gasit:=false;
      while (j<=nr_autobuze) and (not gasit) do
            if (a[j]=i) and (not folosit[j]) then gasit:=true
            else inc(j);
      i:=i+n;
      end;
{ anunta daca au fost gasite toate opririle }
verifica:=gasit;
end;

function opriri:integer;
{ Intoarce numarul primei opriri nestudiate sau 0 daca nu exista }
var i:integer;
begin
i:=1;
while (folosit[i]) and (i<=nr_autobuze) do i:=i+1;
if i>nr_autobuze then opriri:=0
else opriri:=i;
end;

procedure marcheaza(t:integer);
var i:integer;
begin
tminim:=t;
for i:=1 to t do solutie[i]:=vector[i];
end;

procedure cauta(t:integer);
var n,i,j:integer;
begin
n:=1;
while (n<=30) do
      begin
      vector[t]:=n;
      { daca traseul cu prima oprire la momentul a[t] si perioada n verifica
}
      if verifica(t,n) then
         begin
         { ii marcheaza opririle ca folosite }
         i:=a[t];
         j:=t;
         while i<=59 do
               begin
               while (j<=nr_autobuze) and (a[j]<>i) do inc(j);
               if j<=nr_autobuze then
               if not folosit[j] then
                  begin
                  folosit[j]:=true;
                  i:=i+n;
                  end
               else j:=j+1;
               end;
         { daca mai exista opriri }
         j:=opriri;
         { repeta procedura pentru urmatoarea oprire }
         if j<>0 then cauta(j)
         { altfel marcheaza solutia }
         else if t<tminim then marcheaza(t);
         { demarcheaza opririle }
         i:=a[t];
         j:=t;
         while i<=59 do
               begin
               while (j<=nr_autobuze) and (a[j]<>i) and (a[j]<=i) do inc(j);
               if folosit[j] then
                  begin
                  folosit[j]:=false;
                  i:=i+n;
                  end
               else j:=j+1;
               end;
         end;
      inc(n);
      end;
end;

begin
clrscr;
assign(input,'input.i16');
reset(input);
readln(input,nr_autobuze);
for i:=1 to nr_autobuze do
    begin
    read(a[i]);
    folosit[i]:=false;
    end;
tminim:=17;
cauta(1);
for i:=1 to tminim do writeln(a[i],' ',solutie[i]);
close(input);
end.
---------------------------------------------------
